home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / sml_nj / 93src.lha / src / cps / freemap.sml < prev    next >
Encoding:
Text File  |  1993-01-27  |  5.1 KB  |  152 lines
  1. signature FREEMAP =
  2.   sig
  3.     val freevars: CPS.cexp -> CPS.lvar list
  4.     val freemap : (CPS.lvar * CPS.lvar list -> unit)
  5.             -> (CPS.cexp -> CPS.lvar list)
  6.     val cexp_freevars: (CPS.lvar->CPS.lvar list) -> CPS.cexp -> CPS.lvar list
  7.     val freemapClose : CPS.cexp
  8.             -> ((CPS.lvar -> CPS.lvar list) *
  9.                 (CPS.lvar -> bool) *
  10.                 (CPS.lvar -> bool))
  11.   end
  12.  
  13. structure FreeMap : FREEMAP =
  14. struct
  15. open CPS SortedList
  16.  
  17. local fun vars(l, VAR x :: rest) = vars(x::l, rest)
  18.     | vars(l, _::rest) = vars(l,rest)
  19.     | vars(l, nil) = uniq l
  20. in fun clean l = vars(nil, l)
  21. end
  22. val enter = fn (VAR x,y) => enter(x,y) | (_,y) => y
  23.  
  24. val rec freevars =
  25.   fn APP(v,args) => enter(v,clean args)
  26.    | SWITCH(v,c,l) => enter(v,foldmerge (map freevars l))
  27.    | RECORD(_,l,w,ce) => merge(clean (map #1 l), rmv(w, freevars ce))
  28.    | SELECT(_,v,w,ce) => enter(v, rmv(w, freevars ce))
  29.    | OFFSET(_,v,w,ce) => enter(v, rmv(w, freevars ce))
  30.    | SETTER(_,vl,e) => merge(clean vl, freevars e)
  31.    | LOOKER(_,vl,w,e) => merge(clean vl, rmv(w, freevars e))
  32.    | ARITH(_,vl,w,e) => merge(clean vl, rmv(w, freevars e))
  33.    | PURE(_,vl,w,e) => merge(clean vl, rmv(w, freevars e))
  34.    | BRANCH(_,vl,c,e1,e2) => merge(clean vl, merge(freevars e1, freevars e2))
  35.    | FIX(fl,e) =>
  36.     let fun g(f,vl,ce) = difference(freevars ce, uniq vl)
  37.      in difference(foldmerge (freevars e :: map g fl), uniq(map #1 fl))
  38.     end
  39.  
  40.  
  41.  
  42. fun freemap add =
  43. let 
  44.     (* Doesn't apply "add" to the rebound variables of a branch *)
  45.  
  46.     fun setvars (w,free) = let val g = rmv(w,free)
  47.                in add(w,g); g
  48.                end
  49.     val rec freevars =
  50.      fn APP(v,args) => enter(v,clean args)
  51.       | SWITCH(v,c,l) => enter(v,foldmerge (map freevars l))
  52.       | RECORD(_,l,w,ce) => merge(clean (map #1 l), setvars(w, freevars ce))
  53.       | SELECT(_,v,w,ce) => enter(v, setvars(w, freevars ce))
  54.       | OFFSET(_,v,w,ce) => enter(v, setvars(w, freevars ce))
  55.       | SETTER(_,vl,e) => merge(clean vl, freevars e)
  56.       | LOOKER(_,vl,w,e) => merge(clean vl, setvars(w, freevars e))
  57.       | ARITH(_,vl,w,e) => merge(clean vl, setvars(w, freevars e))
  58.       | PURE(_,vl,w,e) => merge(clean vl, setvars(w, freevars e))
  59.       | BRANCH(_,vl,c,e1,e2) => 
  60.         merge(clean vl,merge(freevars e1, freevars e2))
  61.       | FIX _ => ErrorMsg.impossible "FIX in Freemap.freemap"
  62. in freevars
  63. end
  64.  
  65.  
  66.  
  67. (* 
  68.  * cexp_freevars
  69.  *    - To be used in conjunction with FreeMap.freemap.
  70.  *    Consequently, raises an exception for FIX.
  71.  *)
  72. fun cexp_freevars lookup cexp =
  73.     let val rec f = 
  74.     fn RECORD(_,vl,w,_) => merge(clean(map #1 vl), lookup w)
  75.      | SELECT(_,v,w,_) => enter(v, lookup w)
  76.      | OFFSET(_,v,w,_) => enter(v, lookup w)
  77.      | APP(f,vl) =>  clean (f::vl)
  78.      | FIX _ => ErrorMsg.impossible "FIX in Freemap.cexp_freevars"
  79.      | SWITCH(v,c,cl) => 
  80.            enter(v, foldmerge (map f cl))
  81.          | SETTER(_,vl,e) => merge(clean vl, f e)
  82.      | LOOKER(_,vl,w,e) => merge(clean vl, lookup w)
  83.      | ARITH(_,vl,w,e) => merge(clean vl, lookup w)
  84.      | PURE(_,vl,w,e) => merge(clean vl, lookup w)
  85.      | BRANCH(_,vl,c,e1,e2) => merge(clean vl,merge(f e1, f e2))
  86.     in f cexp
  87.     end
  88.  
  89.  
  90. (* Produces a free variable mapping at each function binding.
  91.    The mapping includes the functions bound at the FIX, but
  92.    not the arguments of the function. *)
  93. fun freemapClose ce =
  94. let exception Freemap
  95.     val vars : lvar list Intmap.intmap = Intmap.new(32, Freemap)
  96.     val escapes = Intset.new()
  97.     val escapesP = Intset.mem escapes
  98.     fun escapesM(VAR v) = Intset.add escapes v
  99.       | escapesM _ = ()
  100.     val known = Intset.new()
  101.     val knownM = Intset.add known
  102.     val rec freevars =
  103.      fn FIX(l,ce) =>
  104.         let val functions = uniq(map #1 l)
  105.             (* MUST be done in this order due to side-effects *)
  106.             val freeb = freevars ce
  107.             val freel =
  108.             fold (fn ((v,args,body),freel) =>
  109.                    (let val l = remove(uniq args,freevars body)
  110.                 in  Intmap.add vars (v,l);
  111.                     l::freel
  112.                 end))
  113.                   l nil
  114.         in  app (fn v => if escapesP v then () else knownM v)
  115.                 functions;
  116.             remove(functions,foldmerge(freeb::freel))
  117.         end
  118.       | APP(v,args) => (app escapesM args;
  119.                 enter(v, clean args))
  120.       | SWITCH(v,c,l) => foldmerge (clean[v]::(map freevars l))
  121.       | RECORD(_,l,w,ce) => (app (escapesM o #1) l;
  122.                    merge(clean (map #1 l), rmv(w,freevars ce)))
  123.       | SELECT(_,v,w,ce) => enter(v,rmv(w,freevars ce))
  124.       | OFFSET(_,v,w,ce) => enter(v,rmv(w,freevars ce))
  125.       | LOOKER(_,vl,w,ce) => (app escapesM vl; 
  126.                  merge(clean vl, rmv(w,freevars ce)))
  127.       | ARITH(_,vl,w,ce) => (app escapesM vl;
  128.                 merge(clean vl, rmv(w,freevars ce)))
  129.       | PURE(_,vl,w,ce) => (app escapesM vl;
  130.                    merge(clean vl, rmv(w,freevars ce)))
  131.       | SETTER(_,vl,ce) => (app escapesM vl; merge(clean vl, freevars ce))
  132.       | BRANCH(_,vl,c,e1,e2) =>
  133.               (app escapesM vl; 
  134.            merge(clean vl,merge(freevars e1, freevars e2)))
  135. in  freevars ce;
  136.     (Intmap.map vars, Intset.mem escapes, Intset.mem known)
  137. end
  138.  
  139. (* temporary, for debugging *)
  140. fun timeit f a =
  141.   let val t = System.Timer.start_timer()
  142.       val r = f a
  143.   in  System.Stats.update(System.Stats.freemap,System.Timer.check_timer t);
  144.       r
  145.   end
  146. val freemap = timeit freemap
  147. val freemapClose = timeit freemapClose
  148. val freevars = timeit freevars
  149.  
  150. end (* structure FreeMap *)
  151.  
  152.